## Chapter 4 (Cross-Party Friendships) 
## Our Common Bonds 
## Winter 2021 - 2022  

## Read in source file 
source("ocb_replication_file.r")

################################
## AmeriSpeak Friendship Data ##
################################

friends <- read_sav(file="data/8423_Friendship_21Dec2018.sav") 

## Does the treatment improve FT ratings? 
friends <- friends %>% 
  mutate(other_ft = ifelse(Q10<101,Q10,NA),
         same_ft = ifelse(Q11<101,Q11,NA), 
         ft_pol = same_ft - other_ft, 
         treatment = ifelse(RND_01==1,1,0))

m0 <- lm(other_ft ~ treatment,
         data= friends)
m1 <- lm(same_ft ~ treatment,
         data = friends)
## yes, effects on other-party FT, no effects on same-party 

## Draw the other-party FT graph 
## Make a graph of the distribution of FT Ratings 
pdf(file="figures/chi_levendusky_fig04006.pdf")
ggplot(data = friends) + 
  geom_density(aes(x=other_ft, 
                   group=as.factor(treatment), 
                   linetype=as.factor(treatment),
                   fill=as.factor(treatment)), alpha=0.35) + 
  theme_bw() + 
  ylab("") +
  xlab("Out-Party Feeling Thermometer") + 
  ggtitle("") + 
  scale_fill_grey(name="", 
                  labels=c("Control","Treatment"), 
                  start = 0.10, 
                  end = 0.8) + 
  scale_linetype(name="",
                 labels=c("Control","Treatment"),
                 limits=c(0,1)) + 
  theme(plot.title = element_text(hjust=0.5),
        legend.position = "bottom",
        axis.text.y = element_blank(),
        axis.ticks.y = element_blank(),
        panel.grid = element_blank()) 
dev.off() 

## FT scale transformations 
friends <- friends %>% 
  mutate(zero_ft = ifelse(other_ft == 0, 1,0), 
         lessthanfive = ifelse(other_ft < 6,1,0),
         greaterthanfifty = ifelse(other_ft > 49,1,0)) 

m2 <- lm(zero_ft ~ treatment,
         data = friends) 
m3<- lm(greaterthanfifty ~ treatment, 
        data = friends) 

## Trait Ratings \& Trust in the Other Party 
friends <- friends %>% 
  mutate(patriotic = ifelse(Q14A<6,Q14A,NA), 
         intelligent = ifelse(Q14B<6,Q14B,NA), 
         honest = ifelse(Q14C<6,Q14C,NA), 
         openminded = ifelse(Q14D<6,Q14D,NA), 
         generous = ifelse(Q14E<6,Q14E,NA),
         ## reverse-scale negative traits 
         rev_hypocritical = ifelse(Q14F<6,(-1*Q14F)+6,NA),
         rev_selfish = ifelse(Q14G<6,(-1*Q14G)+6,NA), 
         rev_mean = ifelse(Q14H<6,(-1*Q14H)+6,NA), 
         ## trust in the other party 
         other_trust = ifelse(Q15<6,Q15,NA), 
         ## frequency of political discussion 
         talk_politics = ifelse(Q9<8,-1*(Q9)+5,NA) ) %>% 
  ## now find the average trait levels & overall index 
  rowwise(.) %>% 
  mutate(avg_trait = mean(c(patriotic,intelligent,honest,
                            openminded,generous,
                            rev_hypocritical,rev_selfish,
                            rev_mean),na.rm=T),
         avg_pos = mean(c(patriotic,intelligent,honest,
                          openminded,generous),na.rm=T),
         avg_neg = mean(c(rev_hypocritical,rev_selfish,
                          rev_mean),na.rm=T), 
         ap_index = mean(c((avg_trait/5),(other_ft/100),
                           (other_trust/5)),na.rm=T)) %>% 
  ## remove the row-wise structure 
  ungroup(.)

## do these trait ratings hang together? 
psych::alpha(cbind(friends$patriotic, friends$intelligent,
                   friends$honest,friends$openminded,
                   friends$generous))
psych::alpha(cbind(friends$rev_hypocritical,
                   friends$rev_selfish, friends$rev_mean))
psych::alpha(cbind(friends$patriotic, friends$intelligent,
                   friends$honest,friends$openminded,
                   friends$generous, friends$rev_hypocritical,
                   friends$rev_selfish, friends$rev_mean))
psych::alpha(cbind((friends$avg_trait/5),(friends$other_ft/100),
                   (friends$other_trust/5)))
## positive traits: alpha = 0.80 
## negative traits: alpha = 0.84 
## all traits: alpha = 0.82 
## all AP measures : alpha = 0.76 

## Does the treatment imrpove trait/trust ratings? 
m4 <- lm(avg_pos ~ treatment, 
         data = friends)
m5 <- lm(avg_neg ~ treatment, 
         data = friends)
m6 <- lm(avg_trait ~ treatment, 
         data = friends)
m7 <- lm(other_trust ~ treatment, 
         data = friends) 
m8 <- lm(ap_index ~ treatment, 
         data = friends)
m9 <- lm(ap_index ~ talk_politics,
         data = friends)

## output regression results as a table for the appendix 
stargazer(m0, m1, m2, m3, m4, m5, m6, m7, m8, m9,
          covariate.labels = c("Treatment","Freq. of \n Pol. Discussion","Constant"),
          digits = 2, 
          keep.stat = c("n","rsq"),
          type = "html",
          out = "tables/raw output/appendix_table_4_3.html")

## Draw a graph of the trait rating and average trust level
pdf(file="figures/chi_levendusky_fig04007.pdf")
ggplot(data=friends) + 
  geom_bar(aes(x=honest, 
               y=100*..prop..,
               fill=as.factor(treatment)),
           position="dodge") + 
  xlab("") + 
  ylab("Percentage")  + 
  scale_x_continuous(breaks=c(1:5),
                     labels=c("Not at All \n Well","Not Too \n Well",
                              "Somewhat \n Well","Very \n Well","Extremely \n Well")) + 
  theme_bw() +   
  ggtitle("") + 
  scale_fill_grey(name="", 
                  labels=c("Control","Treatment"), 
                  start = 0.10, 
                  end = 0.8) + 
  theme(plot.title = element_text(hjust=0.5),
        legend.position = "bottom",
        panel.grid = element_blank()) 
dev.off()

## Graph of other-party trust 
pdf(file="figures/chi_levendusky_fig04008.pdf")
ggplot(data=friends) + 
  geom_bar(aes(x=other_trust, 
               y=100*..prop..,
               fill=as.factor(treatment)),
           position="dodge") + 
  xlab("") + 
  ylab("Percentage")  + 
  scale_x_continuous(breaks=c(1:5),
                     labels=c("Almost Never","Once in a While",
                              "About Half the Time","Most of the Time","Almost Always")) +   
  theme_bw() +   
  ggtitle("") + 
  scale_fill_grey(name="", 
                  labels=c("Control","Treatment"), 
                  start = 0.10, 
                  end = 0.8) + 
  theme(plot.title = element_text(hjust=0.5),
        legend.position = "bottom",
        panel.grid = element_blank()) 
dev.off()

## Talking Politics Summary Table 
m10 <- lm(ap_index ~ talk_politics, 
          data = friends) 
m11 <- lm(other_ft ~ talk_politics, 
          data = friends) 
m12 <- lm(avg_pos ~ talk_politics, 
          data = friends) 
m13 <- lm(avg_neg ~ talk_politics, 
          data = friends) 
m14 <- lm(other_trust ~ talk_politics, 
          data = friends) 

stargazer(m10,m11,m12,m13,m14,
          column.labels =c("Affective Polarization Index","Out-Party Feeling Therm.",
                           "Positive Trait Ratings","Negative Trait Ratings",
                           "Out-Party Trust"),
          covariate.labels = c("Freq. of Pol. Discussion","Constant"),
          digits = 2, 
          keep.stat = c("n","rsq"),
          type = "html",
          out = "tables/raw output/table_four_one.html") 

###########################
## Bovitz Party Cue Data ##
###########################

cues <- read_csv(file="data/bovitz_party_cue_data.csv") 

## Code up being in the friendship condition 
cues <- cues %>% 
  ## friendship vs. control (1 = treatment, 0 = control) 
  mutate(friendship = ifelse(is.na(q24) & is.na(q23),1,0)) 

## RA coded the open-ended responses to help clarify 
openended_codes <- read_excel(path="data/open_ended_coding.xlsx")
## just get the variables you need 
openended_codes <- openended_codes %>% 
  select(respondent_id,know_noone,good_one,avoid_politics,
         friend,family,coworker,politician,unclear,non_compliant) %>% 
  mutate(know_noone = as.numeric(know_noone),
         good_one = as.numeric(good_one))

## merge w/ original data 
with_codes <- left_join(x = cues,  
                        y = openended_codes, 
                        by = c("respondent_id" = "respondent_id")) 
## anti-join to check for errors (should be 0)
anti_join(x = openended_codes,
          y = cues,
          by = c("respondent_id" = "respondent_id"))

## code up all responses to respondent classification & those with reject the cue 
with_codes <- with_codes %>% 
  ## codes are: 1 = friend, 2 = family, 3 =  coworker, 4 = neighbor, 5 = celebrity, 6 = unclear
  mutate(who_is = ifelse(q27_1 < 5,q27_1,
                         ifelse(friend == 1, 1, 
                                ifelse(family == 1,2, 
                                       ifelse(coworker == 1, 3,
                                              ifelse(politician == 1, 5, 
                                                     ifelse(unclear == 1,6,NA)))))),
         reject_prompt = ifelse(q27_1 < 5,0,
                                ifelse(know_noone == 1,1,0)),
         reject_prompt = ifelse(friendship == 0, NA, reject_prompt),
         ignore_prompt = ifelse(q27_1 < 5,0,
                                ifelse(non_compliant == 1,1,0)),
         ignore_prompt = ifelse(friendship == 0, NA, ignore_prompt))

## how does this break down? 
prop.table(table(with_codes$who_is))
## the vast majority are friends/family (75%), roughly 10% are co-workers,
## abd then about 6-7 percent each are neighbors or celebrities (most politicians)
## for a bit under 1% of people, we can't tell who they mean 

## make this into a graph 
pdf(file="figures/chi_levendusky_fig04004.pdf")
ggplot(data=with_codes) + 
  geom_bar(aes(x=who_is, 
               y=100*..prop..)) + 
  xlab("") + 
  ylab("Percentage")  + 
  scale_x_continuous(breaks=c(1:6),
                     labels=c("Friend","Family Member","Coworker","Neighbor","Celebrity","Unclear")) + 
  theme_bw() +   
  ggtitle("") + 
  theme(panel.grid = element_blank())
dev.off()

## graph of closeness 
pdf(file="figures/chi_levendusky_fig04005.pdf")
with_codes %>% 
  filter(who_is < 5) %>% 
  ggplot(data=.) + 
  geom_bar(aes(x=q28_1, 
               y=100*..prop..)) + 
  xlab("") + 
  ylab("Percentage")  + 
  scale_x_continuous(breaks=c(1:5),
                     labels=c("Extremely \n Close","Very \n Close",
                              "Somewhat \n Close","Not Too \n Close",
                              "Not at \n All Close")) + 
  theme_bw() +   
  ggtitle("") + 
  theme(panel.grid = element_blank())
dev.off()

prop.table(table(with_codes$q28_1[with_codes$who_is < 5])) 
## 85% are at least somewhat close 
tapply(with_codes$q28_1,with_codes$who_is,function(x)mean(x, na.rm=T))
## closest to family, then friends, then coworkers, then neighbors 


## percent who reject the prompt (say they know no one)? 
mean(with_codes$reject_prompt, na.rm=T)
## percent who ignore the prompt (type gibberish or yell at us)
mean(with_codes$ignore_prompt, na.rm=T)
## 12% don't know anyone from the other party, less than 1% ignore the prompt 

## For appendix: replicating main effects 
## Treatment Assignment & affective polarization measures 
cues <- cues %>% 
  mutate(party_id = ifelse(q37 == 1 & q19 == 1, 1,
                           ifelse(q37 == 1 & q19 == 2,2,
                                  ifelse(q37 == 2 & q21 == 1,3,
                                         ifelse(q37 == 2 & q21 == 2,5,
                                                ifelse(q37 == 3 & q20 == 2,6, 
                                                       ifelse(q37 == 3 & q20 == 1,7,NA)))))),
         party_id = ifelse(q37 == 2 & is.na(cues$q21),4,party_id),
         same_party_ft = ifelse(party_id < 4, q47_2,
                                ifelse(party_id > 4, q67_2,NA)),
         out_party_ft =  ifelse(party_id < 4, q47_1,
                                ifelse(party_id > 4, q67_1,NA)),
         ft_pol = same_party_ft - out_party_ft, 
         out_party_trust = ifelse(party_id < 4, q49, 
                                  ifelse(party_id > 4, q50,NA))) 


## Did the friendship treatment reduce AP? 
m6 <- lm(out_party_ft ~ friendship, 
         data = cues) 
m7 <- lm(out_party_trust ~ friendship,
         data = cues) 

stargazer(m6,m7, 
          covariate.labels = c("Treatment","Constant"),
          digits = 2, 
          keep.stat = c("n","rsq"),
          type = "html",
          out = "tables/raw output/appendix_table_four_four.html")


## Does closeness moderate the effect of the treatment? 
with_codes <- with_codes %>% 
  mutate(party_id = ifelse(q37 == 1 & q19 == 1, 1,
                           ifelse(q37 == 1 & q19 == 2,2,
                                  ifelse(q37 == 2 & q21 == 1,3,
                                         ifelse(q37 == 2 & q21 == 2,5,
                                                ifelse(q37 == 3 & q20 == 2,6, 
                                                       ifelse(q37 == 3 & q20 == 1,7,NA)))))),
         party_id = ifelse(q37 == 2 & is.na(cues$q21),4,party_id),
         same_party_ft = ifelse(party_id < 4, q47_2,
                                ifelse(party_id > 4, q67_2,NA)),
         out_party_ft =  ifelse(party_id < 4, q47_1,
                                ifelse(party_id > 4, q67_1,NA)),
         ft_pol = same_party_ft - out_party_ft, 
         out_party_trust = ifelse(party_id < 4, q49, 
                                  ifelse(party_id > 4, q50,NA)),
         closeness = (-1*q28_1) + 6)

## regression models 
m8 <- lm(out_party_ft ~ closeness, 
         data = with_codes,
         subset = who_is < 5) 
m9 <- lm(out_party_trust ~ closeness, 
         data = with_codes,
         subset = who_is < 5) 
stargazer(m8,m9, 
          covariate.labels = c("Closeness","Constant"),
          digits = 2, 
          keep.stat = c("n","rsq"),
          type = "html",
          out = "tables/raw output/table_four_two.html")


